﻿#VisualFreeBasic_Form#  Version=5.0.0
Locked=0

[Form]
Name=Form1
ClassStyle=CS_VREDRAW, CS_HREDRAW, CS_DBLCLKS
WinStyle=WS_POPUP, WS_THICKFRAME, WS_CAPTION, WS_SYSMENU, WS_MINIMIZEBOX, WS_MAXIMIZEBOX, WS_CLIPSIBLINGS, WS_CLIPCHILDREN, WS_VISIBLE,WS_EX_WINDOWEDGE, WS_EX_CONTROLPARENT, WS_EX_LEFT, WS_EX_LTRREADING, WS_EX_RIGHTSCROLLBAR
Style=3 - 常规窗口
Icon=
Caption=粒子系统模拟
StartPosition=1 - 屏幕中心
WindowState=0 - 正常
Enabled=True
Left=0
Top=0
Width=705
Height=613
Child=False
MdiChild=False
TitleBar=True
SizeBox=True
SysMenu=True
MaximizeBox=True
MinimizeBox=True
Help=False
Hscroll=False
Vscroll=False
MinWidth=0
MinHeight=0
MaxWidth=0
MaxHeight=0
MousePass=False
TransPer=0
TransColor=SYS,25
MousePointer=0 - 默认
BackColor=SYS,15
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[Picture]
Name=Picture1
Index=-1
Style=0 - 无边框
Enabled=True
Visible=True
Left=41
Top=31
Width=245
Height=207
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[Timer]
Name=Timer1
Index=-1
Interval=100
Enabled=True
Left=107
Top=364
Tag=


[AllCode]

Type P_t
    X As Single
    Y As Single
    XV As Single
    YV As Single
    
    R As Single '半径
    M As Single '质量
    Res As Single '反弹性
End Type

Dim Shared Points(200) As P_t
Const Grav As Double = 98
Const WallResist As Double = 0.5
Const PointResist As Double = 1000
Dim Shared SceneWidth As Single, SceneHeight As Single, DeltaTime As Double

Dim Shared MouX As Single, MouY As Single, MouB As Boolean
Dim Shared MouC As Long

Const PI As Double = 3.14159265358979

Dim Shared Keys(255) As Boolean
'--------------------------------------------------------------------------------
Sub InitPoints(ByVal XL As Double, YL As Double, WL As Double, HL As Double)
  Dim I As Long
  
  For I = 0 To UBound(Points) - 1
      With Points(I)
      .R = 8 + Rnd * 15
      .M = .R * .R * .R * PI * 4 / 3
      .X = XL + Rnd * WL
      .Y = YL + Rnd * HL
      .Res = PointResist
      End With
  Next
  
  With Points(I)
  .R = 40
  .M = .R * .R * .R * PI * 4 / 3
  .X = XL + Rnd * WL
  .Y = YL + Rnd * HL
  .Res = PointResist
  End With
  
End Sub
'--------------------------------------------------------------------------------
Sub Movement(ByVal DT As Double)
  Dim As Long  I, J
  
  For I = 0 To UBound(Points)
      With Points(I)
      .YV = .YV + Grav * DT
      .X = .X + .XV * DT
      .Y = .Y + .YV * DT
      
      If Keys(87) Then .YV = .YV - 200 * DT
      If Keys(83) Then .YV = .YV + 200 * DT
      If Keys(65) Then .XV = .XV - 200 * DT
      If Keys(68) Then .XV = .XV + 200 * DT
      
      If MouB And MouC = I Then
          Points(I).XV = (MouX - Points(I).X) / DT
          Points(I).YV = (MouY - Points(I).Y) / DT
          'Points(I).X = MouX
          'Points(I).Y = MouY
      End If
      End With
  Next
  
  For I = 0 To UBound(Points)
      For J = 0 To UBound(Points)
          If I <> J Then
              Dim Hit As Boolean
              Hit = False
              
              Dim Vel As Double '速率
              Vel = Sqr(Points(I).XV * Points(I).XV + Points(I).YV * Points(I).YV) '根据速度判断相交
              Dim Dist As Double, DifX As Double, DifY As Double 'I到J的向量
              DifX = Points(J).X - Points(I).X
              DifY = Points(J).Y - Points(I).Y
              Dist = Sqr(DifX * DifX + DifY * DifY) '距离
              DifX = DifX / Dist '单位向量
              DifY = DifY / Dist
              
              Dim MinDist As Double, MinDistSq As Double
              MinDist = Points(I).R + Points(J).R
              MinDistSq = MinDist * MinDist
              
              If Dist < MinDist Then
                  Dim Force As Double
                  Force = (1 - Dist / MinDist) * (Points(I).Res + Points(J).Res) * 0.5
                  
                  Points(I).XV = Points(I).XV - DifX * Force * DT * Points(J).M / Points(I).M
                  Points(I).YV = Points(I).YV - DifY * Force * DT * Points(J).M / Points(I).M
                  
                  Points(J).XV = Points(J).XV + DifX * Force * DT * Points(I).M / Points(J).M
                  Points(J).YV = Points(J).YV + DifY * Force * DT * Points(I).M / Points(J).M
              End If
          End If
      Next
  Next
  
  For I = 0 To UBound(Points)
      With Points(I)
      If .X < .R Then
          .X = .R
          .XV = Abs(.XV * WallResist)
      End If
      If .Y < .R Then
          .Y = .R
          .YV = Abs(.YV * WallResist)
      End If
      If .X > SceneWidth - .R Then
          .X = SceneWidth - .R
          .XV = -Abs(.XV * WallResist)
      End If
      If .Y > SceneHeight - .R Then
          .Y = SceneHeight - .R
          .YV = -Abs(.YV * WallResist)
      End If
      End With
  Next
  
End Sub
'--------------------------------------------------------------------------------

Function 平方(ByVal nVal As Double) As Double
  平方 = nVal * nVal
End Function
'--------------------------------------------------------------------------------

Function 射线与圆的相交点(ByVal 起点X As Double, ByVal 起点Y As Double, ByVal 方向X As Double, ByVal 方向Y As Double, ByVal 距离限制 As Double, ByVal 圆心X As Double, ByVal 圆心Y As Double, ByVal 半径平方 As Double, 交点X As Double, 交点Y As Double) As Boolean
  '             _____
  '        _,-"~     ~"-,_
  '     ,+~               ~+,
  '   ,+"                   "+,
  '  ,"                       ",
  ' ＋                         ＋
  ' /                           \
  '丨           圆心            丨
  '|              *--------------+-------------=* 起点
  '丨              \＼_         丨        _,-"~
  ' \         直角边\  ＼半径   /    _,-"~方向（单位向量）
  ' ＋               \   ＼_  ,＋,-"~
  '  ",               \     ＼*"交点
  '   "+,          直角*,-"~,+"
  '     ~+,               ,+~
  '        ~"-,_     _,-"~
  '             ~~~~~
  Dim 起点到圆心X As Double, 起点到圆心Y As Double, 距离平方 As Double
  起点到圆心X = 圆心X - 起点X
  起点到圆心Y = 圆心Y - 起点Y
  If 方向X * 起点到圆心X + 方向Y * 起点到圆心Y < 0 Then Exit Function '如果射线的方向背道而驰则退出
  距离平方 = 起点到圆心X * 起点到圆心X + 起点到圆心Y * 起点到圆心Y
  
  Dim 直角边长度平方 As Double, 方向所在直角边长度平方 As Double
  方向所在直角边长度平方 = 平方(方向X * 起点到圆心X + 方向Y * 起点到圆心Y)
  直角边长度平方 = 距离平方 - 方向所在直角边长度平方
  If 直角边长度平方 < 0 Or 直角边长度平方 > 半径平方 Then Exit Function
  
  Dim 退回的距离平方 As Double, 交点到起点的距离 As Double
  退回的距离平方 = 半径平方 - 直角边长度平方
  If 退回的距离平方 < 0 Then Exit Function
  
  交点到起点的距离 = Sqr(方向所在直角边长度平方) - Sqr(退回的距离平方)
  If 交点到起点的距离 > 距离限制 Then Exit Function
  
  交点X = 起点X + 方向X * 交点到起点的距离
  交点Y = 起点Y + 方向Y * 交点到起点的距离
  射线与圆的相交点 = True
End Function


'--------------------------------------------------------------------------------
Sub Form1_WM_Create(hWndForm As hWnd,UserData As Integer)  '完成创建窗口及所有的控件后，此时窗口还未显示。注：自定义消息里 WM_Create 此时还未创建控件和初始赋值。
      
'  Threaddetach ThreadCreate (@Moni,0)

End Sub
'--------------------------------------------------------------------------
Sub Moni(aa As Long ) '
  Dim I As Long
  Dim TimeFreq As ULongInt
  Dim LastTime As ULongInt, ThisTime As ULongInt
  '  Dim nDC As hDC
  '  Dim ps As rect
  '  Dim nText As String
  
  QueryPerformanceFrequency @TimeFreq
  QueryPerformanceCounter @ThisTime
  LastTime = ThisTime
  
  
  InitPoints 0, 0, SceneWidth, SceneHeight
  Do
      LastTime = ThisTime
      'Do
      QueryPerformanceCounter @ThisTime
      DeltaTime = (ThisTime - LastTime) / TimeFreq
      'Loop While DeltaTime < 1 / 60
      
      picture1.Refresh() 
      FF_DoEvents
  Loop
  
End Sub


'--------------------------------------------------------------------------------
Sub Form1_WM_Size(hWndForm As hWnd, fwSizeType As Long, nWidth As Long, nHeight As Long)  '窗口已经改变了大小

  Picture1.move   0, 0, nWidth, nHeight
  SceneWidth = nWidth
  SceneHeight = nHeight

End Sub


'--------------------------------------------------------------------------------
Sub Form1_Picture1_WM_MouseMove(hWndForm As hWnd, hWndControl As hWnd, MouseFlags As Long, xPos As Long, yPos As Long)  '移动鼠标

  MouX = xPos
  MouY = yPos

End Sub


'--------------------------------------------------------------------------------
Sub Form1_Picture1_WM_LButtonUp(hWndForm As hWnd, hWndControl As hWnd, MouseFlags As Long, xPos As Long, yPos As Long)  '释放鼠标左键

  MouB = False
  MouC = -1

End Sub


'--------------------------------------------------------------------------------
Sub Form1_Picture1_WM_LButtonDown(hWndForm As hWnd, hWndControl As hWnd, MouseFlags As Long, xPos As Long, yPos As Long)  '按下鼠标左键

  MouB = True
  Dim I As Long
  For I = 0 To UBound(Points)
      Dim SX As Single, SY As Single
      SX = xPos - Points(I).X
      SY = yPos - Points(I).Y
      If SX * SX + SY * SY <= Points(I).R * Points(I).R Then
          MouC = I
          Exit For
      End If
  Next

End Sub


'--------------------------------------------------------------------------------
Function Form1_WM_Close(hWndForm As hWnd) As LResult  '即将关闭窗口，返回非0可阻止关闭

  End
  Function = 0   ' 根据你的需要改变
End Function


'--------------------------------------------------------------------------------
Function Form1_Picture1_WM_Paint(hWndForm As hWnd, hWndControl As hWnd) As LResult  '重绘，系统通知控件需要重新绘画。

  Dim nDC As hDC
  Dim ps As PAINTSTRUCT
  Dim As Long w,h,x,a,i,r,g,b,u
  Dim nText As String,jj As Single 
  nDC=BeginPaint(hWndControl,@ps) '获取需要绘画DC，推荐此方法，绘图效率高
  FF_Control_GetSize( hWndControl, w, h )
  Dim pMemBmp As CMemBmp = CMemBmp(w,h)  '创建内存DC，先画内存DC，加速画画速度，避免产生闪耀
  '需要内存DC类，必须在 FF_AppStart 模块里加   #include Once  "afx\CMemBmp.inc"
  '自己画画
  If DeltaTime Then
      nText="FPS:" &  1 / DeltaTime '显示正确的FPS
      TextOutA pMemBmp.GetMemDC , 5,5,StrPtr(nText),Len(nText)
      If DeltaTime > 0.1 Then DeltaTime = 0.1
      Movement DeltaTime
  End If
  u=UBound(Points)+1
  jj=256/(u/7)
  For I = 0 To U-1
'      Ellipse pMemBmp.GetMemDC, Points(I).X-Points(I).R, Points(I).Y-Points(I).R,Points(I).X+ Points(I).R,Points(I).Y+ Points(I).R
    If i<u/7 Then
        r=i*jj
         g=r
          b=r
    ElseIf i<u/7*2 Then
        r=(i-u/4)*jj: g=r: b=255
    ElseIf i<u/7*3 Then
        r=(i-u/2)*jj: g=255: b=r
    ElseIf i<u/7*4 Then
        r=255: g=(i-u/4*3)*jj: b=g
    ElseIf i<u/7*5 Then
        r=(i-u/4*3)*jj: b=255:g=255
    ElseIf i<u/7*6 Then
        r=255: g=(i-u/4*3)*jj: b=255
    Else 
        r=255: g=255: b=(i-u/4*3)*jj
    End If
    
    DrawEllipse( pMemBmp.GetMemDC,  Points(I).X-Points(I).R, Points(I).Y-Points(I).R, Points(I).R*2, Points(I).R*2, PS_SOLID,1, 0, BGR(r,g,b) )
  Next
  
  
  '自己画画完成
  BitBlt ndc,0,0,w,h,pMemBmp.GetMemDC,0,0,SrcCopy '将内存DC，输出到控件
  EndPaint(hWndForm,@ps) '完成绘图
  Function=True
End Function


'--------------------------------------------------------------------------------
Sub Form1_Timer1_WM_Timer(hWndForm As hWnd, wTimerID As Long)  '定时器

  KillTimer( hWndForm,wTimerID )
  Moni(0 ) '

End Sub


